home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / pbc_bas.exe / SHOWICON.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-01-12  |  1.9 KB  |  58 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE FUNCTION AscM% (St$, BYVAL Posn%)
  8.    DECLARE SUB FClose1 (BYVAL FileHandle%)
  9.    DECLARE SUB FOpen1 (FileName$, BYVAL ReadWrite%, BYVAL Sharing%, FileHandle%, ErrCode%)
  10.    DECLARE SUB FSetLoc (BYVAL FileHandle%, Posn&)
  11.    DECLARE FUNCTION GetFSize& (FileName$)
  12.    DECLARE SUB SFRead (BYVAL FileHandle%, St$, BytesRead%, ErrCode%)
  13.  
  14. SUB ShowIcon (FileName$, StartX%, StartY%, ErrCode%)
  15.    DIM W2DC%(0 TO 15)   ' color translation table
  16.    W2DC%(0) = 0
  17.    W2DC%(1) = 4
  18.    W2DC%(2) = 2
  19.    W2DC%(3) = 14
  20.    W2DC%(4) = 1
  21.    W2DC%(5) = 5
  22.    W2DC%(6) = 3
  23.    W2DC%(7) = 7
  24.    W2DC%(8) = 8
  25.    W2DC%(9) = 12
  26.    W2DC%(10) = 10
  27.    W2DC%(11) = 14
  28.    W2DC%(12) = 9
  29.    W2DC%(13) = 13
  30.    W2DC%(14) = 11
  31.    W2DC%(15) = 15
  32.    IF INSTR(FileName$, ".") THEN
  33.       File$ = FileName$
  34.    ELSE
  35.       File$ = FileName$ + ".ICO"
  36.    END IF
  37.    IF GetFSize&(File$) = 766& THEN
  38.       FOpen1 File$, 0, 2, IconFile%, ErrCode%
  39.    ELSE
  40.       ErrCode% = -1
  41.    END IF
  42.    FileOpen% = (ErrCode% = 0)
  43.    IF ErrCode% = 0 THEN
  44.       FSetLoc IconFile%, CLNG(22 + (32 + 8) + (4 * 16) + 1)
  45.       Icon$ = SPACE$(32 * 16)
  46.       SFRead IconFile%, Icon$, BytesRead%, ErrCode%
  47.    END IF
  48.    IF ErrCode% = 0 THEN
  49.       FOR y% = 0 TO 31
  50.          FOR x% = 0 TO 15
  51.             PSET (StartX% + x% * 2, StartY% + 31 - y%), W2DC%(AscM(Icon$, y% * 16 + x% + 1) \ 16)
  52.             PSET (StartX% + x% * 2 + 1, StartY% + 31 - y%), W2DC%(AscM(Icon$, y% * 16 + x% + 1) AND 15)
  53.          NEXT
  54.       NEXT
  55.    END IF
  56.    IF FileOpen% THEN FClose1 IconFile%
  57. END SUB
  58.